home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 2
/
SPACE - Library 2 - Volume 1.iso
/
apps
/
136
/
applic
/
quiklbl2.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-05-14
|
17KB
|
435 lines
PROGRAM quicklabel ; { By David Lindsley }
CONST
{$I GEMCONST.PAS}
TYPE
{$I gemtype.pas}
Txtfile = File of Text;
Adrptr = ^Adrlist;
Adrlist =
RECORD
FirstLine: Str255;
SecondLine: Str255;
ThirdLine: Str255;
FourthLine: Str255;
END;
VAR
status : long_integer;
dialog, Info_Box, Style_box : Dialog_Ptr ;
a, b,c, d, e, f, g, res, dummy,
info_btn, print_btn, cancel_btn, size_btn,
first_item, second_item, third_item, fourth_item : integer ;
alert_str : Str255 ;
Adrfile: Txtfile;
Adrs : Adrptr;
button : Tree_Index;
flag, tall_flag, wide_flag, bold_flag, cond_flag,
italic_flag, normal_flag : Boolean;
{$I gemsubs}
FUNCTION printout_stat : long_integer;
GEMDOS($11);
FUNCTION getrez : integer;
XBIOS( 4 );
PROCEDURE styledialog ;
VAR
button, ok_btn, style_item, wide_btn,
tall_btn, italic_btn, bold_btn,
cond_btn, normal_btn : integer ;
BEGIN
Style_Box := New_Dialog ( 15, 0, 0, 36, 18 ) ;
style_item := Add_DItem(Style_Box, G_Text, None, 11, 1, 15, 1, 0, $1180);
Set_DText (Style_Box, style_item, '*** STYLE ***', System_Font,
TE_Center ) ;
wide_btn := Add_DItem(Style_Box, G_Button, Touch_Exit,
5, 4, 11, 2, 1, $1180 );
Set_DText ( Style_Box, wide_btn, 'Wide', System_Font, TE_Center );
Obj_SetState(Style_Box, wide_btn, 0, false );
if wide_flag then
obj_SetState(Style_box, wide_btn, 4, false );
tall_btn := Add_DItem ( Style_Box, G_Button, Touch_Exit,
5, 7, 11, 2, 1, $1180) ;
Set_DText ( Style_Box, tall_btn, 'Tall', System_Font, TE_Center );
Obj_SetState(Style_Box, tall_btn, 0, false );
if tall_flag then
obj_SetState(Style_Box, tall_btn, 4, false );
italic_btn := Add_DItem( Style_Box, G_Button, Touch_Exit,
20, 4, 11, 2, 1, $1180);
Set_DText ( Style_Box, italic_btn, 'Italic',System_Font, TE_Center );
Obj_SetState(Style_Box, italic_btn, 0, false );
if italic_flag then
obj_SetState(Style_Box, italic_btn, 4, false );
bold_btn := Add_DItem ( Style_Box, G_Button, Touch_Exit,
20, 7, 11, 2, 1, $1180);
Set_DText ( Style_Box, bold_btn, 'Bold', System_Font, TE_Center );
Obj_SetState(Style_Box, bold_btn, 0, false );
if bold_flag then
obj_SetState(Style_Box, bold_btn, 4, false );
cond_btn := Add_DItem ( Style_Box, G_Button, Touch_Exit,
20, 10, 11, 2, 1, $1180);
Set_DText ( Style_Box, cond_btn, 'Condensed',System_Font, TE_Center );
Obj_SetState(Style_Box, cond_btn, 0, false );
if cond_flag then
obj_SetState(Style_Box, cond_btn, 4, false );
normal_btn := Add_DItem( Style_Box,G_Button, Touch_Exit,
5, 10, 11, 2, 1, $1180);
Set_DText ( Style_Box, normal_btn, 'Normal', System_Font, TE_Center );
Obj_SetState(Style_Box, normal_btn, 0, false );
if normal_flag then
obj_SetState(Style_Box, normal_btn, 4, false );
ok_btn := Add_DItem( Style_Box, G_Button, Selectable|Exit_Btn|Default,
13, 15, 11, 2, 2, $1180 ) ;
Set_DText (Style_Box, ok_btn, 'Okay', System_Font, TE_Center ) ;
Center_Dialog ( Style_Box) ;
button := Do_Dialog ( Style_Box, 0 ) ;
while (button=wide_btn) or (button=tall_btn) or (button=normal_btn)
or (button=italic_btn) or (button=bold_btn) or (button=cond_btn)
do begin
IF button = wide_btn THEN
BEGIN
a := obj_state(Style_Box, wide_btn);
if a=4 then begin
obj_setstate(Style_box, wide_btn, 0, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(87), chr(0));
end;
if a <> 4 then begin
g := obj_state(Style_Box, normal_btn);
if g=4 then begin
obj_setstate(Style_box, normal_btn, 0, true );
end;
obj_setstate(Style_box, wide_btn,4, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(87), chr(1));
end;
END;
IF button = tall_btn THEN
BEGIN
b := obj_state(Style_Box, tall_btn);
if b=4 then begin
obj_setstate(Style_box, tall_btn, 0, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(28), chr(86), chr(0));
{ for Epson: chr(27), chr(104),chr(0) }
end;
if b <> 4 then begin
g := obj_state(Style_Box, normal_btn);
if g=4 then begin
obj_setstate(Style_box, normal_btn, 0, true );
end;
obj_setstate(Style_box, tall_btn,4, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(28), chr(86), chr(1));
{ for Epson: chr(27), chr(104), chr(1)) }
end;
END;
IF button = italic_btn THEN
BEGIN
d := obj_state(Style_Box, italic_btn);
if d=4 then begin
obj_setstate(Style_box, italic_btn, 0, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(53));
end;
if d <> 4 then begin
g := obj_state(Style_Box, normal_btn);
if g=4 then begin
obj_setstate(Style_box, normal_btn, 0, true );
end;
obj_setstate(Style_box, italic_btn,4, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(52));
end;
END;
IF button = bold_btn THEN
BEGIN
e := obj_state(Style_Box, bold_btn);
if e=4 then begin
obj_setstate(Style_box, bold_btn, 0, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(72));
end;
if e <> 4 then begin
g := obj_state(Style_Box, normal_btn);
if g=4 then begin
obj_setstate(Style_box, normal_btn, 0, true );
end;
obj_setstate(Style_box, bold_btn,4, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(71));
end;
END;
IF button = cond_btn THEN
BEGIN
f := obj_state(Style_Box, cond_btn);
if f=4 then begin
obj_setstate(Style_box, cond_btn, 0, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(18));
end;
if f <> 4 then begin
g := obj_state(Style_Box, normal_btn);
if g=4 then begin
obj_setstate(Style_box, normal_btn, 0, true );
end;
obj_setstate(Style_box, cond_btn,4, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(15));
end;
END;
IF button = normal_btn THEN
BEGIN
g := obj_state(Style_Box, normal_btn);
if g=4 then begin
obj_setstate(Style_box, normal_btn, 0, true );
end;
if g <> 4 then begin
a := obj_state(Style_Box, wide_btn);
b := obj_state(Style_Box, tall_btn);
d := obj_state(Style_Box, italic_btn);
e := obj_state(Style_Box, bold_btn);
f := obj_state(Style_Box, cond_btn);
if a=4 then begin
obj_setstate(Style_box, wide_btn, 0, true );
end;
if b=4 then begin
obj_setstate(Style_box, tall_btn, 0, true );
end;
if d=4 then begin
obj_setstate(Style_box, italic_btn, 0, true );
end;
if e=4 then begin
obj_setstate(Style_box, bold_btn, 0, true );
end;
if f=4 then begin
obj_setstate(Style_box, cond_btn, 0, true );
end;
obj_setstate(Style_box, normal_btn,4, true );
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(64));
end;
END;
button := Redo_Dialog (Style_Box,0);
end;
if button = ok_btn then begin
a := obj_state(Style_box, wide_btn);
if a = 4 then
wide_flag := true;
if a <> 4 then
wide_flag := false;
b := obj_state(Style_box, tall_btn);
if b = 4 then
tall_flag := true;
if b <> 4 then
tall_flag := false;
d := obj_state(Style_box, italic_btn);
if d = 4 then
italic_flag := true;
if d <> 4 then
italic_flag := false;
e := obj_state(Style_box, bold_btn);
if e = 4 then
bold_flag := true;
if e <> 4 then
bold_flag := false;
f := obj_state(Style_box, cond_btn);
if f = 4 then
cond_flag := true;
if f <> 4 then
cond_flag := false;
g := obj_state(Style_box, normal_btn);
if g = 4 then
normal_flag := true;
if g <> 4 then
normal_flag := false;
end;
End_Dialog ( Style_Box ) ;
END ;
PROCEDURE infodialog ;
VAR
button, ok_btn, more_btn, info_item : integer ;
BEGIN
Info_Box := New_Dialog ( 15, 0, 0, 40, 19 ) ;
Info_item := Add_DItem ( Info_Box, G_Text, None, 2, 1, 36, 1, 0, $1180) ;
Set_DText( Info_Box, Info_item, 'QUICK LABEL PROGRAM', System_Font,
TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 3, 36, 1, 0, $1180 );
Set_DText ( Info_Box, info_item, 'by David Lindsley', Small_Font,
TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 5, 36, 1, 0, $1180 );
Set_DText ( Info_Box, info_item, '* Use TAB or arrow keys', System_Font,
TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 6, 36, 1, 0, $1180) ;
Set_DText ( Info_Box, info_item,'to advance to next line.',System_Font,
TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 8, 36, 1, 0, $1180) ;
Set_DText ( Info_Box, info_item, '* Use RETURN or "PRINT" button',
System_Font, TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 9, 36, 1, 0, $1180);
Set_DText ( Info_Box, info_item, 'to print label.',
System_Font, TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 11, 36, 1, 0, $1180);
Set_DText ( Info_Box, info_item, '* Use ESC key to clear line.',
System_Font, TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 14, 36, 1, 0, $1180);
Set_DText ( Info_Box, info_item, 'Portions of this program copyright',
Small_Font, TE_Center ) ;
info_item := Add_DItem ( Info_Box, G_Text, None, 2, 15, 36, 1, 0, $1180);
Set_DText ( Info_Box, info_item,
'OSS and CCD. Used by permission',
Small_Font, TE_Center ) ;
ok_btn := Add_DItem ( Info_Box, G_Button, Selectable|Exit_Btn|Default,
16, 17, 8, 1, 2, $1180 ) ;
Set_DText ( Info_Box, ok_btn, 'OKAY', System_Font, TE_Center ) ;
Center_Dialog ( Info_Box) ;
button := Do_Dialog ( Info_Box, 0 ) ;
End_Dialog ( Info_Box ) ;
END ;
PROCEDURE Set_Up_Dialog;
BEGIN
dialog := New_Dialog( 15, 0, 0, 52, 14 ) ;
dummy := Add_DItem( dialog, G_Box, None, 0, 0, 52, 14, 2, $1121 );
dummy := Add_DItem( dialog, G_BoxText, None, 6, 1, 40, 2, 1, $1180 );
Set_DText(dialog, dummy, 'QUICK LABEL PROGRAM' ,System_Font, TE_Center );
dummy := Add_DItem( dialog, G_BoxText, None, 6, 3, 40, 1, 1, $1180 );
Set_DText( dialog, dummy, 'by David Lindsley', Small_Font, TE_Center );
first_item := Add_DItem( dialog, G_FText,Editable, 9, 6, 32, 1, 0, $1180 );
Set_DEdit( dialog, first_item, '________________________________',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', '', System_Font, TE_Center );
second_item := Add_Ditem(dialog, G_FText, Editable, 9, 7, 32, 1, 0, $1180);
Set_DEdit( dialog, second_item, '________________________________',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', '', System_Font, TE_Center );
third_item := Add_DItem( dialog, G_FText, Editable, 9, 8, 32, 1, 0, $1180);
Set_DEdit( dialog, third_item, '________________________________',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', '', System_Font, TE_Center );
fourth_item := Add_DItem(dialog, G_FText, Editable, 9, 9, 32, 1, 0, $1180);
Set_DEdit( dialog, fourth_item, '________________________________',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX','',System_Font,TE_Center );
print_btn := Add_DItem( dialog, G_Button, Selectable|Exit_Btn|Default,
5, 12, 8, 1, 1, $1180 ) ;
Set_DText( dialog, print_btn, 'PRINT', System_Font, TE_Center ) ;
cancel_btn := Add_DItem( dialog, G_Button, Selectable|Exit_Btn,
35, 12, 8, 1, 1, $1180 ) ;
Set_DText( dialog, cancel_btn, 'QUIT', System_Font, TE_Center ) ;
info_btn := Add_DItem(dialog, G_Button, Selectable|Touch_Exit,
15, 12, 8, 1, 1, $1180 );
Set_DText( dialog, info_btn, 'INFO', System_Font, TE_Center );
size_btn := Add_DItem(dialog, G_Button, Selectable|Touch_Exit,
25, 12, 8, 1, 1, $1180 );
Set_DText( dialog, size_btn, 'STYLE' , System_Font, TE_Center );
END;
PROCEDURE LPrint(P:Adrptr);
BEGIN
status := printout_stat;
if status = 0 then begin
dummy := do_alert('[3][ | | Turn the printer on.][ OK ]',1);
end;
Rewrite(Adrfile,'PRN:' ); { OPEN UP PRINTER }
Writeln(Adrfile,P^.FirstLine);
Writeln(Adrfile,P^.SecondLine);
Writeln(Adrfile,P^.ThirdLine);
Writeln(Adrfile,P^.Fourthline);
Writeln(Adrfile); { blank line }
Writeln(Adrfile); { blank line }
END;
PROCEDURE Show_Box(P:Adrptr);
BEGIN
REPEAT
Center_Dialog( dialog ) ;
Obj_SetState(dialog,print_btn,Normal, False );
Obj_SetState(dialog,info_btn, Normal, False );
Obj_SetState(dialog,cancel_btn,Normal,False );
Obj_SetState(dialog,size_btn,Normal,False );
Set_DText (dialog,first_item,P^.FirstLine,System_Font, TE_Left);
Set_DText (dialog,second_item,P^.SecondLine,System_Font, TE_Left);
Set_DText (dialog,third_item,P^.ThirdLine,System_Font, TE_Left);
Set_DText (dialog,fourth_item,P^.FourthLine,System_Font, TE_Left);
button := Do_Dialog( dialog, first_item ) ;
IF (button<>cancel_btn ) THEN
BEGIN
Get_DEdit(dialog,first_item,P^.FirstLine);
Get_DEdit(dialog,second_item,P^.SecondLine);
Get_DEdit(dialog,third_item, P^.ThirdLine);
Get_DEdit(dialog,fourth_item,P^.FourthLine);
END;
IF button = print_btn THEN
BEGIN
LPrint(P)
END;
IF button = info_btn THEN
BEGIN
infodialog;
END;
IF button = size_btn THEN
BEGIN
styledialog;
END;
IF button = cancel_btn THEN
BEGIN
b:= do_alert('[1][ | |You pressed the QUIT button][I know|oops]',1);
IF b = 1 THEN
BEGIN
flag := TRUE;
END;
END;
UNTIL (flag = TRUE) OR (P = NIL);
d := do_alert('[2][Return printer to default mode?][ YES | NO ]',1);
if d = 1 then begin
Rewrite(Adrfile, 'PRN:');
Write(Adrfile, chr(27), chr(64));
end;
END;
BEGIN
IF Init_Gem >= 0 THEN
BEGIN
init_mouse;
res := getrez;
if res = 0 then
BEGIN
dummy:=do_alert('[3][ | | Does not support Low Resolution][ ok ]',1);
halt;
END;
status := printout_stat;
if status = 0 then begin
dummy := do_alert('[3][ | | Turn the printer on.][ OK ]',1);
end;
Set_Mouse( M_Point_Hand );
Set_Up_Dialog;
New(Adrs);
Adrs^.FirstLine := '';
Show_Box(Adrs);
Exit_Gem ;
END;
END.